home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / lib / perl5 / Net / DBus / Binding / Iterator.pm < prev    next >
Encoding:
Perl POD Document  |  2008-02-20  |  18.7 KB  |  714 lines
  1. # -*- perl -*-
  2. #
  3. # Copyright (C) 2004-2006 Daniel P. Berrange
  4. #
  5. # This program is free software; You can redistribute it and/or modify
  6. # it under the same terms as Perl itself. Either:
  7. #
  8. # a) the GNU General Public License as published by the Free
  9. #   Software Foundation; either version 2, or (at your option) any
  10. #   later version,
  11. #
  12. # or
  13. #
  14. # b) the "Artistic License"
  15. #
  16. # The file "COPYING" distributed along with this file provides full
  17. # details of the terms and conditions of the two licenses.
  18.  
  19. =pod
  20.  
  21. =head1 NAME
  22.  
  23. Net::DBus::Binding::Iterator - Reading and writing message parameters
  24.  
  25. =head1 SYNOPSIS
  26.  
  27. Creating a new message
  28.  
  29.   my $msg = new Net::DBus::Binding::Message::Signal;
  30.   my $iterator = $msg->iterator;
  31.  
  32.   $iterator->append_boolean(1);
  33.   $iterator->append_byte(123);
  34.  
  35.  
  36. Reading from a mesage
  37.  
  38.   my $msg = ...get it from somewhere...
  39.   my $iter = $msg->iterator();
  40.  
  41.   my $i = 0;
  42.   while ($iter->has_next()) {
  43.     $iter->next();
  44.     $i++;
  45.     if ($i == 1) {
  46.        my $val = $iter->get_boolean();
  47.     } elsif ($i == 2) {
  48.        my $val = $iter->get_byte();
  49.     }
  50.   }
  51.  
  52. =head1 DESCRIPTION
  53.  
  54. Provides an iterator for reading or writing message
  55. fields. This module provides a Perl API to access the
  56. dbus_message_iter_XXX methods in the C API. The array
  57. and dictionary types are not yet supported, and there
  58. are bugs in the Quad support (ie it always returns -1!).
  59.  
  60. =head1 METHODS
  61.  
  62. =over 4
  63.  
  64. =cut
  65.  
  66. package Net::DBus::Binding::Iterator;
  67.  
  68.  
  69. use 5.006;
  70. use strict;
  71. use warnings;
  72.  
  73. use Net::DBus;
  74.  
  75. =item $res = $iter->has_next()
  76.  
  77. Determines if there are any more fields in the message
  78. itertor to be read. Returns a positive value if there
  79. are more fields, zero otherwise.
  80.  
  81. =item $success = $iter->next()
  82.  
  83. Skips the iterator onto the next field in the message.
  84. Returns a positive value if the current field pointer
  85. was successfully advanced, zero otherwise.
  86.  
  87. =item my $val = $iter->get_boolean()
  88.  
  89. =item $iter->append_boolean($val);
  90.  
  91. Read or write a boolean value from/to the
  92. message iterator
  93.  
  94. =item my $val = $iter->get_byte()
  95.  
  96. =item $iter->append_byte($val);
  97.  
  98. Read or write a single byte value from/to the
  99. message iterator.
  100.  
  101. =item my $val = $iter->get_string()
  102.  
  103. =item $iter->append_string($val);
  104.  
  105. Read or write a UTF-8 string value from/to the
  106. message iterator
  107.  
  108. =item my $val = $iter->get_object_path()
  109.  
  110. =item $iter->append_object_path($val);
  111.  
  112. Read or write a UTF-8 string value, whose contents is
  113. a valid object path, from/to the message iterator
  114.  
  115. =item my $val = $iter->get_signature()
  116.  
  117. =item $iter->append_signature($val);
  118.  
  119. Read or write a UTF-8 string, whose contents is a 
  120. valid type signature, value from/to the message iterator
  121.  
  122. =item my $val = $iter->get_int16()
  123.  
  124. =item $iter->append_int16($val);
  125.  
  126. Read or write a signed 16 bit value from/to the
  127. message iterator
  128.  
  129. =item my $val = $iter->get_uint16()
  130.  
  131. =item $iter->append_uint16($val);
  132.  
  133. Read or write an unsigned 16 bit value from/to the
  134. message iterator
  135.  
  136. =item my $val = $iter->get_int32()
  137.  
  138. =item $iter->append_int32($val);
  139.  
  140. Read or write a signed 32 bit value from/to the
  141. message iterator
  142.  
  143. =item my $val = $iter->get_uint32()
  144.  
  145. =item $iter->append_uint32($val);
  146.  
  147. Read or write an unsigned 32 bit value from/to the
  148. message iterator
  149.  
  150. =item my $val = $iter->get_int64()
  151.  
  152. =item $iter->append_int64($val);
  153.  
  154. Read or write a signed 64 bit value from/to the
  155. message iterator. An error will be raised if this
  156. build of Perl does not support 64 bit integers
  157.  
  158. =item my $val = $iter->get_uint64()
  159.  
  160. =item $iter->append_uint64($val);
  161.  
  162. Read or write an unsigned 64 bit value from/to the
  163. message iterator. An error will be raised if this
  164. build of Perl does not support 64 bit integers
  165.  
  166. =item my $val = $iter->get_double()
  167.  
  168. =item $iter->append_double($val);
  169.  
  170. Read or write a double precision floating point value 
  171. from/to the message iterator
  172.  
  173. =cut
  174.  
  175. sub get_int64 {
  176.     my $self = shift;
  177.     return $self->_get_int64;
  178. }
  179.  
  180. sub get_uint64 {
  181.     my $self = shift;
  182.     return $self->_get_uint64;
  183. }
  184.  
  185. sub append_int64 {
  186.     my $self = shift;
  187.     $self->_append_int64(shift);
  188. }
  189.  
  190. sub append_uint64 {
  191.     my $self = shift;
  192.     $self->_append_uint64(shift);
  193. }
  194.  
  195. =item my $value = $iter->get()
  196.  
  197. =item my $value = $iter->get($type);
  198.  
  199. Get the current value pointed to by this iterator. If the optional
  200. C<$type> parameter is supplied, the wire type will be compared with
  201. the desired type & a warning output if their differ. The C<$type>
  202. value must be one of the C<Net::DBus::Binding::Message::TYPE*>
  203. constants.
  204.  
  205. =cut
  206.  
  207. sub get {
  208.     my $self = shift;    
  209.     my $type = shift;
  210.  
  211.     if (defined $type) {
  212.     if (ref($type)) {
  213.         if (ref($type) eq "ARRAY") {
  214.         # XXX we should recursively validate types
  215.         $type = $type->[0];
  216.         if ($type eq &Net::DBus::Binding::Message::TYPE_DICT_ENTRY) {
  217.             $type = &Net::DBus::Binding::Message::TYPE_ARRAY;
  218.         }
  219.         } else {
  220.         die "unsupport type reference $type";
  221.         }
  222.     }
  223.  
  224.     my $actual = $self->get_arg_type;
  225.     if ($actual != $type) {
  226.         # "Be strict in what you send, be leniant in what you accept"
  227.         #    - ie can't rely on python to send correct types, eg int32 vs uint32
  228.         # But, don't complain for variants because a number of apps (eg HAL)
  229.         # claim to return variants, but in fact don't correctly encode their
  230.         # data as variants. Technically a bug in the server, but it does
  231.         # 'just work' normally.
  232.         warn "requested type '" . chr($type) . "' ($type) did not match wire type '" . chr($actual) . "' ($actual)"
  233.         if $type != &Net::DBus::Binding::Message::TYPE_VARIANT;
  234.  
  235.         $type = $actual;
  236.     }
  237.     } else {
  238.     $type = $self->get_arg_type;
  239.     }
  240.  
  241.     if ($type == &Net::DBus::Binding::Message::TYPE_STRING) {
  242.     return $self->get_string;
  243.     } elsif ($type == &Net::DBus::Binding::Message::TYPE_BOOLEAN) {
  244.     return $self->get_boolean;
  245.     } elsif ($type == &Net::DBus::Binding::Message::TYPE_BYTE) {
  246.     return $self->get_byte;
  247.     } elsif ($type == &Net::DBus::Binding::Message::TYPE_INT16) {
  248.     return $self->get_int16;
  249.     } elsif ($type == &Net::DBus::Binding::Message::TYPE_UINT16) {
  250.     return $self->get_uint16;
  251.     } elsif ($type == &Net::DBus::Binding::Message::TYPE_INT32) {
  252.     return $self->get_int32;
  253.     } elsif ($type == &Net::DBus::Binding::Message::TYPE_UINT32) {
  254.     return $self->get_uint32;
  255.     } elsif ($type == &Net::DBus::Binding::Message::TYPE_INT64) {
  256.     return $self->get_int64;
  257.     } elsif ($type == &Net::DBus::Binding::Message::TYPE_UINT64) {
  258.     return $self->get_uint64;
  259.     } elsif ($type == &Net::DBus::Binding::Message::TYPE_DOUBLE) {
  260.     return $self->get_double;
  261.     } elsif ($type == &Net::DBus::Binding::Message::TYPE_ARRAY) {
  262.     my $array_type = $self->get_element_type();
  263.     if ($array_type == &Net::DBus::Binding::Message::TYPE_DICT_ENTRY) {
  264.         return $self->get_dict();
  265.     } else {
  266.         return $self->get_array($array_type);
  267.     }
  268.     } elsif ($type == &Net::DBus::Binding::Message::TYPE_STRUCT) {
  269.     return $self->get_struct();
  270.     } elsif ($type == &Net::DBus::Binding::Message::TYPE_VARIANT) {
  271.     return $self->get_variant();
  272.     } elsif ($type == &Net::DBus::Binding::Message::TYPE_DICT_ENTRY) {
  273.     die "dictionary can only occur as part of an array type";
  274.     } elsif ($type == &Net::DBus::Binding::Message::TYPE_INVALID) {
  275.     die "cannot handle Net::DBus::Binding::Message::TYPE_INVALID";
  276.     } elsif ($type == &Net::DBus::Binding::Message::TYPE_OBJECT_PATH) {
  277.     return $self->get_object_path();
  278.     } elsif ($type == &Net::DBus::Binding::Message::TYPE_SIGNATURE) {
  279.     return $self->get_signature();
  280.     } else {
  281.     die "unknown argument type '" . chr($type) . "' ($type)";
  282.     }
  283. }
  284.  
  285. =item my $hashref = $iter->get_dict()
  286.  
  287. If the iterator currently points to a dictionary value, unmarshalls
  288. and returns the value as a hash reference. 
  289.  
  290. =cut
  291.  
  292. sub get_dict {
  293.     my $self = shift;
  294.     
  295.     my $iter = $self->_recurse();
  296.     my $type = $iter->get_arg_type();
  297.     my $dict = {};
  298.     while ($type == &Net::DBus::Binding::Message::TYPE_DICT_ENTRY) {
  299.     my $entry = $iter->get_struct();
  300.     if ($#{$entry} != 1) {
  301.         die "Dictionary entries must be structs of 2 elements. This entry has " . ($#{$entry}+1) ." elements";
  302.     }
  303.     
  304.     $dict->{$entry->[0]} = $entry->[1];
  305.     $iter->next();
  306.     $type = $iter->get_arg_type();
  307.     }
  308.     return $dict;
  309. }
  310.  
  311. =item my $hashref = $iter->get_array()
  312.  
  313. If the iterator currently points to an array value, unmarshalls
  314. and returns the value as a array reference. 
  315.  
  316. =cut
  317.  
  318. sub get_array {
  319.     my $self = shift;
  320.     my $array_type = shift;
  321.     
  322.     my $iter = $self->_recurse();
  323.     my $type = $iter->get_arg_type();
  324.     my $array = [];
  325.     while ($type != &Net::DBus::Binding::Message::TYPE_INVALID) {
  326.     if ($type != $array_type) {
  327.         die "Element $type not of array type $array_type";
  328.     }
  329.  
  330.     my $value = $iter->get($type);
  331.     push @{$array}, $value;
  332.     $iter->next();
  333.     $type = $iter->get_arg_type();
  334.     }
  335.     return $array;
  336. }
  337.  
  338. =item my $hashref = $iter->get_variant()
  339.  
  340. If the iterator currently points to a variant value, unmarshalls
  341. and returns the value contained in the variant.
  342.  
  343. =cut
  344.  
  345. sub get_variant {
  346.     my $self = shift;
  347.  
  348.     my $iter = $self->_recurse();
  349.     return $iter->get();
  350. }
  351.  
  352.  
  353. =item my $hashref = $iter->get_struct()
  354.  
  355. If the iterator currently points to an struct value, unmarshalls
  356. and returns the value as a array reference. The values in the array 
  357. correspond to members of the struct.
  358.  
  359. =cut
  360.  
  361. sub get_struct {
  362.     my $self = shift;
  363.     
  364.     my $iter = $self->_recurse();
  365.     my $type = $iter->get_arg_type();
  366.     my $struct = [];
  367.     while ($type != &Net::DBus::Binding::Message::TYPE_INVALID) {
  368.     my $value = $iter->get($type);
  369.     push @{$struct}, $value;
  370.     $iter->next();
  371.     $type = $iter->get_arg_type();
  372.     }
  373.     return $struct;
  374. }
  375.  
  376. =item $iter->append($value)
  377.  
  378. =item $iter->append($value, $type)
  379.  
  380. Appends a value to the message associated with this iterator. The
  381. value is marshalled into wire format, according to the following
  382. rules.
  383.  
  384. If the C<$value> is an instance of L<Net::DBus::Binding::Value>,
  385. the embedded data type is used.
  386.  
  387. If the C<$type> parameter is supplied, that is taken to represent
  388. the data type. The type must be one of the C<Net::DBus::Binding::Message::TYPE_*>
  389. constants.
  390.  
  391. Otherwise, the data type is chosen to be a string, dict or array
  392. according to the perl data types SCALAR, HASH or ARRAY.
  393.  
  394. =cut
  395.  
  396. sub append {
  397.     my $self = shift;
  398.     my $value = shift;
  399.     my $type = shift;
  400.  
  401.     if (ref($value) eq "Net::DBus::Binding::Value" &&
  402.         ((! defined ref($type)) ||
  403.      (ref($type) ne "ARRAY") ||
  404.      $type->[0] != &Net::DBus::Binding::Message::TYPE_VARIANT)) {
  405.     $type = $value->type;
  406.     $value = $value->value;
  407.     }
  408.  
  409.     if (!defined $type) {
  410.     $type = $self->guess_type($value);
  411.     }
  412.  
  413.     if (ref($type) eq "ARRAY") {
  414.     my $maintype = $type->[0];
  415.     my $subtype = $type->[1];
  416.  
  417.     if ($maintype == &Net::DBus::Binding::Message::TYPE_DICT_ENTRY) {
  418.         $self->append_dict($value, $subtype);
  419.     } elsif ($maintype == &Net::DBus::Binding::Message::TYPE_STRUCT) {
  420.         $self->append_struct($value, $subtype);
  421.     } elsif ($maintype == &Net::DBus::Binding::Message::TYPE_ARRAY) {
  422.         $self->append_array($value, $subtype);
  423.     } elsif ($maintype == &Net::DBus::Binding::Message::TYPE_VARIANT) {
  424.         $self->append_variant($value, $subtype);
  425.     } else {
  426.         die "Unsupported compound type ", $maintype, " ('", chr($maintype), "')";
  427.     }
  428.     } else {
  429.     # XXX is this good idea or not
  430.     $value = '' unless defined $value;
  431.  
  432.     if ($type == &Net::DBus::Binding::Message::TYPE_BOOLEAN) {
  433.         $self->append_boolean($value);
  434.     } elsif ($type == &Net::DBus::Binding::Message::TYPE_BYTE) {
  435.         $self->append_byte($value);
  436.     } elsif ($type == &Net::DBus::Binding::Message::TYPE_STRING) {
  437.         $self->append_string($value);
  438.     } elsif ($type == &Net::DBus::Binding::Message::TYPE_INT16) {
  439.         $self->append_int16($value);
  440.     } elsif ($type == &Net::DBus::Binding::Message::TYPE_UINT16) {
  441.         $self->append_uint16($value);
  442.     } elsif ($type == &Net::DBus::Binding::Message::TYPE_INT32) {
  443.         $self->append_int32($value);
  444.     } elsif ($type == &Net::DBus::Binding::Message::TYPE_UINT32) {
  445.         $self->append_uint32($value);
  446.     } elsif ($type == &Net::DBus::Binding::Message::TYPE_INT64) {
  447.         $self->append_int64($value);
  448.     } elsif ($type == &Net::DBus::Binding::Message::TYPE_UINT64) {
  449.         $self->append_uint64($value);
  450.     } elsif ($type == &Net::DBus::Binding::Message::TYPE_DOUBLE) {
  451.         $self->append_double($value);
  452.     } elsif ($type == &Net::DBus::Binding::Message::TYPE_OBJECT_PATH) {
  453.         $self->append_object_path($value);
  454.     } elsif ($type == &Net::DBus::Binding::Message::TYPE_SIGNATURE) {
  455.         $self->append_signature($value);
  456.     } else {
  457.         die "Unsupported scalar type ", $type, " ('", chr($type), "')";
  458.     }
  459.     }
  460. }
  461.  
  462.  
  463. =item my $type = $iter->guess_type($value)
  464.  
  465. Make a best guess at the on the wire data type to use for 
  466. marshalling C<$value>. If the value is a hash reference,
  467. the dictionary type is returned; if the value is an array
  468. reference the array type is returned; otherwise the string
  469. type is returned.
  470.  
  471. =cut
  472.  
  473. sub guess_type {
  474.     my $self = shift;
  475.     my $value = shift;
  476.  
  477.     if (ref($value)) {
  478.     if (UNIVERSAL::isa($value, "Net::DBus::Binding::Value")) {
  479.         my $type = $value->type;
  480.         if (ref($type) && ref($type) eq "ARRAY") {
  481.         my $maintype = $type->[0];
  482.         my $subtype = $type->[1];
  483.  
  484.         if (!defined $subtype) {
  485.             if ($maintype == &Net::DBus::Binding::Message::TYPE_DICT_ENTRY) {
  486.             $subtype = [ $self->guess_type(($value->value())[0]->[0]), 
  487.                      $self->guess_type(($value->value())[0]->[1]) ];
  488.             } elsif ($maintype == &Net::DBus::Binding::Message::TYPE_ARRAY) {
  489.             $subtype = [ $self->guess_type(($value->value())[0]->[0]) ];
  490.             } elsif ($maintype == &Net::DBus::Binding::Message::TYPE_STRUCT) {
  491.             $subtype = [ map { $self->guess_type($_) } @{($value->value())[0]} ];
  492.             } else {
  493.             die "Unguessable compound type '$maintype' ('", chr($maintype), "')\n";
  494.             }
  495.         }
  496.         return [$maintype, $subtype];
  497.         } else {
  498.         return $type;
  499.         }
  500.     } elsif (ref($value) eq "HASH") {
  501.         my $key = (keys %{$value})[0];
  502.         my $val = $value->{$key};
  503.         # XXX Basically impossible to decide between DICT & STRUCT
  504.         return [ &Net::DBus::Binding::Message::TYPE_DICT_ENTRY,
  505.              [ &Net::DBus::Binding::Message::TYPE_STRING, $self->guess_type($val)] ];
  506.     } elsif (ref($value) eq "ARRAY") {
  507.         return [ &Net::DBus::Binding::Message::TYPE_ARRAY,
  508.              [$self->guess_type($value->[0])] ];
  509.     } else {
  510.         die "cannot marshall reference of type " . ref($value);
  511.     }
  512.     } else {
  513.     # XXX Should we bother trying to guess integer & floating point types ?
  514.     # I say sod it, because strongly typed languages will support introspection
  515.     # and loosely typed languages won't care about the difference
  516.     return &Net::DBus::Binding::Message::TYPE_STRING;
  517.     }
  518. }
  519.  
  520. =item my $sig = $iter->format_signature($type)
  521.  
  522. Given a data type representation, construct a corresponding 
  523. signature string
  524.  
  525. =cut
  526.  
  527. sub format_signature {
  528.     my $self = shift;
  529.     my $type = shift;
  530.     my ($sig, $t, $i);
  531.  
  532.     $sig = "";
  533.     $i = 0;use Data::Dumper;
  534.  
  535.     if (ref($type) eq "ARRAY") {
  536.     while ($i <= $#{$type}) {
  537.         $t = $$type[$i];
  538.         
  539.         if (ref($t) eq "ARRAY") {
  540.         $sig .= $self->format_signature($t);
  541.         } elsif ($t == &Net::DBus::Binding::Message::TYPE_DICT_ENTRY) {
  542.         $sig .= chr (&Net::DBus::Binding::Message::TYPE_ARRAY);
  543.         $sig .= "{" . $self->format_signature($$type[++$i]) . "}";
  544.         } elsif ($t == &Net::DBus::Binding::Message::TYPE_STRUCT) {
  545.         $sig .= "(" . $self->format_signature($$type[++$i]) . ")";
  546.         } else {
  547.         $sig .= chr($t);
  548.         }
  549.         
  550.         $i++;
  551.     }
  552.     } else {
  553.     $sig .= chr ($type);
  554.     }
  555.     
  556.     return $sig;
  557. }
  558.  
  559. =item $iter->append_array($value, $type)
  560.  
  561. Append an array of values to the message. The C<$value> parameter
  562. must be an array reference, whose elements all have the same data
  563. type specified by the C<$type> parameter.
  564.  
  565. =cut
  566.  
  567. sub append_array {
  568.     my $self = shift;
  569.     my $array = shift;
  570.     my $type = shift;
  571.     
  572.     if (!defined($type)) {
  573.     $type = [$self->guess_type($array->[0])];
  574.     }
  575.  
  576.     die "array must only have one type"
  577.     if $#{$type} > 0;
  578.  
  579.     my $sig = $self->format_signature($type);
  580.     my $iter = $self->_open_container(&Net::DBus::Binding::Message::TYPE_ARRAY, $sig);
  581.     
  582.     foreach my $value (@{$array}) {
  583.     $iter->append($value, $type->[0]);
  584.     }
  585.  
  586.     $self->_close_container($iter);
  587. }
  588.  
  589.  
  590. =item $iter->append_struct($value, $type)
  591.  
  592. Append a struct to the message. The C<$value> parameter
  593. must be an array reference, whose elements correspond to
  594. members of the structure. The C<$type> parameter encodes
  595. the type of each member of the struct.
  596.  
  597. =cut
  598.  
  599. sub append_struct {
  600.     my $self = shift;
  601.     my $struct = shift;
  602.     my $type = shift;
  603.  
  604.     if (defined($type) &&
  605.     $#{$struct} != $#{$type}) {
  606.     die "number of values does not match type";
  607.     }
  608.  
  609.     my $iter = $self->_open_container(&Net::DBus::Binding::Message::TYPE_STRUCT, "");
  610.     
  611.     my @type = defined $type ? @{$type} : ();
  612.     foreach my $value (@{$struct}) {
  613.     $iter->append($value, shift @type);
  614.     }
  615.  
  616.     $self->_close_container($iter);
  617. }
  618.  
  619. =item $iter->append_dict($value, $type)
  620.  
  621. Append a dictionary to the message. The C<$value> parameter
  622. must be an hash reference.The C<$type> parameter encodes
  623. the type of the key and value of the hash.
  624.  
  625. =cut
  626.  
  627. sub append_dict {
  628.     my $self = shift;
  629.     my $hash = shift;
  630.     my $type = shift;
  631.  
  632.     my $sig;
  633.  
  634.     $sig  = "{";
  635.     $sig .= $self->format_signature($type);
  636.     $sig .= "}";
  637.  
  638.     my $iter = $self->_open_container(&Net::DBus::Binding::Message::TYPE_ARRAY, $sig);
  639.     
  640.     foreach my $key (keys %{$hash}) {
  641.     my $value = $hash->{$key};
  642.     my $entry = $iter->_open_container(&Net::DBus::Binding::Message::TYPE_DICT_ENTRY, "");
  643.  
  644.     $entry->append($key, $type->[0]);
  645.     $entry->append($value, $type->[1]);
  646.     $iter->_close_container($entry);
  647.     }
  648.     $self->_close_container($iter);
  649. }
  650.  
  651. =item $iter->append_variant($value)
  652.  
  653. Append a value to the message, encoded as a variant type. The
  654. C<$value> can be of any type, however, the variant will be
  655. encoded as either a string, dictionary or array according to
  656. the rules of the C<guess_type> method.
  657.  
  658. =cut
  659.  
  660. sub append_variant {
  661.     my $self = shift;
  662.     my $value = shift;
  663.     my $type = shift;
  664.  
  665.     if (UNIVERSAL::isa($value, "Net::DBus::Binding::Value")) {
  666.     $type = [$self->guess_type($value)];
  667.     $value = $value->value;
  668.     } elsif (!defined $type || !defined $type->[0]) {
  669.     $type = [$self->guess_type($value)];
  670.     }
  671.     die "variant must only have one type"
  672.     if defined $type && $#{$type} > 0;
  673.  
  674.     my $sig = $self->format_signature($type->[0]);
  675.     my $iter = $self->_open_container(&Net::DBus::Binding::Message::TYPE_VARIANT, $sig);
  676.     $iter->append($value, $type->[0]);
  677.     $self->_close_container($iter);
  678. }
  679.  
  680.  
  681. =item my $type = $iter->get_arg_type
  682.  
  683. Retrieves the type code of the value pointing to by this iterator.
  684. The returned code will correspond to one of the constants
  685. C<Net::DBus::Binding::Message::TYPE_*>
  686.  
  687. =item my $type = $iter->get_element_type
  688.  
  689. If the iterator points to an array, retrieves the type code of 
  690. array elements. The returned code will correspond to one of the 
  691. constants C<Net::DBus::Binding::Message::TYPE_*>
  692.  
  693. =cut
  694.  
  695. 1;
  696.  
  697. =pod
  698.  
  699. =back
  700.  
  701. =head1 SEE ALSO
  702.  
  703. L<Net::DBus::Binding::Message>
  704.  
  705. =head1 AUTHOR
  706.  
  707. Daniel Berrange E<lt>dan@berrange.comE<gt>
  708.  
  709. =head1 COPYRIGHT
  710.  
  711. Copyright 2004 by Daniel Berrange
  712.  
  713. =cut
  714.